home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / svgabg.exe / VGADEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1992-06-25  |  48KB  |  1,732 lines
  1. program BGIDemo;
  2. {
  3.  
  4.   Turbo Pascal Borland Graphics Interface (BGI) demonstration
  5.   program. This program shows how to use many features of
  6.   the Graph unit.
  7.  
  8.   Copyright (c) 1985-89 by Borland International, Inc.
  9.  
  10. }
  11.  
  12. uses
  13.   Crt, Dos, Graph;
  14.  
  15.  
  16. const
  17.   { The five fonts available }
  18.   Fonts : array[0..4] of string[13] =
  19.   ('DefaultFont', 'TriplexFont', 'SmallFont', 'SansSerifFont', 'GothicFont');
  20.  
  21.   { The five predefined line styles supported }
  22.   LineStyles : array[0..4] of string[9] =
  23.   ('SolidLn', 'DottedLn', 'CenterLn', 'DashedLn', 'UserBitLn');
  24.  
  25.   { The twelve predefined fill styles supported }
  26.   FillStyles : array[0..11] of string[14] =
  27.   ('EmptyFill', 'SolidFill', 'LineFill', 'LtSlashFill', 'SlashFill',
  28.    'BkSlashFill', 'LtBkSlashFill', 'HatchFill', 'XHatchFill',
  29.    'InterleaveFill', 'WideDotFill', 'CloseDotFill');
  30.  
  31.   { The two text directions available }
  32.   TextDirect : array[0..1] of string[8] = ('HorizDir', 'VertDir');
  33.  
  34.   { The Horizontal text justifications available }
  35.   HorizJust  : array[0..2] of string[10] = ('LeftText', 'CenterText', 'RightText');
  36.  
  37.   { The vertical text justifications available }
  38.   VertJust   : array[0..2] of string[10] = ('BottomText', 'CenterText', 'TopText');
  39.  
  40. var
  41.   GraphDriver : integer;  { The Graphics device driver }
  42.   GraphMode   : integer;  { The Graphics mode value }
  43.   MaxX, MaxY  : word;     { The maximum resolution of the screen }
  44.   ErrorCode   : integer;  { Reports any graphics errors }
  45.   MaxColor    : word;     { The maximum color value available }
  46.   OldExitProc : Pointer;  { Saves exit procedure address }
  47.  
  48. function RealDrawColor(Color : Word) : Word;
  49. begin
  50.   if (GetMaxColor > 256) then
  51.     SetRgbPalette(1024,(Color SHR 10) AND 31,(Color SHR 5)AND 31,Color AND 31);
  52.   RealDrawColor := Color;
  53. end;
  54.  
  55. function RealFillColor(Color : Word) : Word;
  56. begin
  57.   if (GetMaxColor > 256) then
  58.     SetRgbPalette(1025,(Color SHR 10) AND 31,(Color SHR 5)AND 31,Color AND 31);
  59.   RealFillColor := Color;
  60. end;
  61.  
  62. function RealColor(Color : Word) : Word;
  63. begin
  64.   if (GetMaxColor > 256) then
  65.     SetRgbPalette(1026,(Color SHR 10) AND 31,(Color SHR 5)AND 31,Color AND 31);
  66.   RealColor := Color;
  67. end;
  68.  
  69. function WhitePixel : Word;
  70. var Clr : Word;
  71. begin
  72.   if (GetMaxColor > 256) then
  73.     Clr := 32767
  74.   else
  75.     Clr := 15;
  76.   WhitePixel := Clr;
  77. end;
  78.  
  79. function BluePixel : Word;
  80. var Clr : Word;
  81. begin
  82.   if (GetMaxColor > 256) then
  83.     Clr := 31
  84.   else
  85.     Clr := 1;
  86.   BluePixel := Clr;
  87. end;
  88.  
  89. function GreenPixel : Word;
  90. var Clr : Word;
  91. begin
  92.   if (GetMaxColor > 256) then
  93.     Clr := 31 SHL 5
  94.   else
  95.     Clr := 2;
  96.   GreenPixel := Clr;
  97. end;
  98.  
  99.  
  100. {$F+}
  101. procedure MyExitProc;
  102. begin
  103.   ExitProc := OldExitProc; { Restore exit procedure address }
  104.   CloseGraph;              { Shut down the graphics system }
  105. end; { MyExitProc }
  106. {$F-}
  107.  
  108. {$F+}
  109. function DetectVGA256 : integer;
  110. { Detects VGA or MCGA video cards }
  111. var
  112.   DetectedDriver : integer;
  113.   SuggestedMode  : integer;
  114. begin
  115.   DetectGraph(DetectedDriver, SuggestedMode);
  116.   if (DetectedDriver = VGA) or (DetectedDriver = MCGA) then
  117.   begin
  118.     Writeln('Which video mode would you like to use?');
  119.     Writeln('  0) 320x200x256');
  120.     Writeln('  1) 640x400x256');
  121.     Writeln('  2) 640x480x256');
  122.     Writeln('  3) 800x600x256');
  123.     Writeln('  4) 1024x768x256');
  124.     Writeln('  5) 640x350x256');
  125.     Writeln('  6) 1280x1024x256');
  126.     Write('> ');
  127.     Readln(SuggestedMode);
  128.     DetectVGA256 := SuggestedMode;
  129.   end
  130.   else
  131.     DetectVGA256 := grError; { Couldn't detect hardware }
  132. end; { DetectVGA256 }
  133. {$F-}
  134.  
  135. {$F+}
  136. function DetectVGA32k : integer;
  137. { Detects VGA or MCGA video cards }
  138. var
  139.   DetectedDriver : integer;
  140.   SuggestedMode  : integer;
  141. begin
  142.   DetectGraph(DetectedDriver, SuggestedMode);
  143.   if (DetectedDriver = VGA) or (DetectedDriver = MCGA) then
  144.   begin
  145.     Writeln('Which video mode would you like to use?');
  146.     Writeln('  0) 320x200x32k');
  147.     Writeln('  1) 640x350x32k');
  148.     Writeln('  2) 640x400x32k');
  149.     Writeln('  3) 640x480x32k');
  150.     Writeln('  4) 800x600x32k');
  151.     Write('> ');
  152.     Readln(SuggestedMode);
  153.     DetectVGA32k := SuggestedMode;
  154.   end
  155.   else
  156.     DetectVGA32k := grError; { Couldn't detect hardware }
  157. end; { DetectVGA32k }
  158. {$F-}
  159.  
  160. {$F+}
  161. function DetectTwk256 : integer;
  162. { Detects VGA or MCGA video cards }
  163. var
  164.   DetectedDriver : integer;
  165.   SuggestedMode  : integer;
  166. begin
  167.   DetectGraph(DetectedDriver, SuggestedMode);
  168.   if (DetectedDriver = VGA) or (DetectedDriver = MCGA) then
  169.   begin
  170.     Writeln('Which video mode would you like to use?');
  171.     Writeln('  0) 320x400x256');
  172.     Writeln('  1) 320x480x256');
  173.     Writeln('  2) 360x480x256');
  174.     Writeln('  3) 376x564x256');
  175.     Writeln('  4) 400x564x256');
  176.     Writeln('  5) 400x600x256');
  177.     Writeln('  6) 320x240x256');
  178.     Write('> ');
  179.     Readln(SuggestedMode);
  180.     DetectTwk256 := SuggestedMode;
  181.   end
  182.   else
  183.     DetectTwk256 := grError; { Couldn't detect hardware }
  184. end; { DetectVGA256 }
  185. {$F-}
  186.  
  187. {$F+}
  188. function DetectVGA16 : integer;
  189. { Detects VGA or MCGA video cards }
  190. var
  191.   DetectedDriver : integer;
  192.   SuggestedMode  : integer;
  193. begin
  194.   DetectGraph(DetectedDriver, SuggestedMode);
  195.   if (DetectedDriver = EGA) or (DetectedDriver = VGA) then
  196.   begin
  197.     Writeln('Which video mode would you like to use?');
  198.     Writeln('  0) 320x200x16');
  199.     Writeln('  1) 640x200x16');
  200.     Writeln('  2) 640x350x16');
  201.     Writeln('  3) 640x480x16');
  202.     Writeln('  4) 800x600x16');
  203.     Writeln('  5) 1024x768x16');
  204.     Write('> ');
  205.     Readln(SuggestedMode);
  206.     DetectVGA16 := SuggestedMode;
  207.   end
  208.   else
  209.     DetectVGA16 := grError; { Couldn't detect hardware }
  210. end; { DetectVGA256 }
  211. {$F-}
  212.  
  213. {$F+}
  214. function DetectTwk16 : integer;
  215. { Detects VGA or MCGA video cards }
  216. var
  217.   DetectedDriver : integer;
  218.   SuggestedMode  : integer;
  219. begin
  220.   DetectGraph(DetectedDriver, SuggestedMode);
  221.   if (DetectedDriver = VGA) then
  222.   begin
  223.     Writeln('Which video mode would you like to use?');
  224.     Writeln('  0) 704x528x16');
  225.     Writeln('  1) 720x540x16');
  226.     Writeln('  2) 736x552x16');
  227.     Writeln('  3) 752x564x16');
  228.     Writeln('  4) 768x576x16');
  229.     Writeln('  5) 784x588x16');
  230.     Writeln('  6) 800x600x16');
  231.     Write('> ');
  232.     Readln(SuggestedMode);
  233.     DetectTwk16 := SuggestedMode;
  234.   end
  235.   else
  236.     DetectTwk16 := grError; { Couldn't detect hardware }
  237. end; { DetectVGA256 }
  238. {$F-}
  239.  
  240. {$F+}
  241. function DetectS3 : integer;
  242. { Detects VGA or MCGA video cards }
  243. var
  244.   DetectedDriver : integer;
  245.   SuggestedMode  : integer;
  246. begin
  247.   DetectGraph(DetectedDriver, SuggestedMode);
  248.   if (DetectedDriver = VGA) then
  249.   begin
  250.     Writeln('Which video mode would you like to use?');
  251.     Writeln('  0) 640x480x256');
  252.     Writeln('  1) 800x600x256');
  253.     Writeln('  2) 1024x768x256');
  254.     Writeln('  3) 800x600x16');
  255.     Writeln('  4) 1024x768x16');
  256.     Writeln('  5) 1280x960x16');
  257.     Writeln('  6) 1280x1024x16');
  258.     Writeln('  7) 640x480x32k');
  259.     Write('> ');
  260.     Readln(SuggestedMode);
  261.     DetectS3 := SuggestedMode;
  262.   end
  263.   else
  264.     DetectS3 := grError; { Couldn't detect hardware }
  265. end; { DetectVGA256 }
  266. {$F-}
  267.  
  268. var
  269.   AutoDetectPointer : pointer;
  270.  
  271. procedure Initialize;
  272. { Initialize graphics and report any errors that may occur }
  273. var
  274.   InGraphicsMode : boolean; { Flags initialization of graphics mode }
  275.   PathToDriver   : string;  { Stores the DOS path to *.BGI & *.CHR }
  276.   UseWhichDriver : integer;
  277. begin
  278.   { when using Crt and graphics, turn off Crt's memory-mapped writes }
  279.   DirectVideo := False;
  280.   OldExitProc := ExitProc;                { save previous exit proc }
  281.   ExitProc := @MyExitProc;                { insert our exit proc in chain }
  282.   PathToDriver := '';
  283.   repeat
  284.     Writeln('Which driver to use?');
  285.     Writeln('  0) Svga256');
  286.     Writeln('  1) Svga16');
  287.     Writeln('  2) Svga32k');
  288.     Writeln('  3) Tweak256');
  289.     Writeln('  4) Tweak16');
  290.     Writeln('  5) S3');
  291.     Write('>');
  292.     Readln(UseWhichDriver);
  293.     if (UseWhichDriver = 0) then
  294.     begin
  295.       AutoDetectPointer := @DetectVGA256;
  296.       GraphDriver := InstallUserDriver('Svga256',Au